home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
pbc22b.zip
/
PBC$BAS.ZIP
/
FILECOPY.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-02-21
|
2KB
|
68 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE FUNCTION ForceMatch$(Pattern$, SourceFile$)
DECLARE FUNCTION GetNameFx$ (Buffer$)
DECLARE FUNCTION GetSizeFx& (Buffer$)
DECLARE SUB CopyFile (FromFile$, ToFile$, ErrCode%)
DECLARE SUB ExtendFSpec (File$, Ext$, FullFile$, ErrCode%)
DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL Attr%, ErrCode%)
DECLARE SUB FindNextFx (Buffer$, ErrCode%)
DECLARE SUB ParseFSpec (FileSpec$, Drive$, DLen%, Subdir$, SLen%, File$, FLen%)
SUB FileCopy (Source$, Dest$, FileCount%, ByteCount&, ErrCode%)
FileCount% = 0
ByteCount& = 0
ExtendFSpec Source$, ".", Src$, ErrCode%
IF ErrCode% THEN EXIT SUB
SDrv$ = " "
SDir$ = SPACE$(64)
SFile$ = SPACE$(12)
ParseFSpec Src$, SDrv$, D%, SDir$, S%, SFile$, F%
SDrv$ = LEFT$(SDrv$, D%)
SDir$ = LEFT$(SDir$, S%)
SFile$ = LEFT$(SFile$, F%)
SPath$ = SDrv$ + ":" + SDir$
IF RIGHT$(SPath$, 1) <> "\" THEN SPath$ = SPath$ + "\"
ExtendFSpec Dest$, ".", Dst$, ErrCode%
IF ErrCode% THEN EXIT SUB
DDrv$ = " "
DDir$ = SPACE$(64)
DFile$ = SPACE$(12)
ParseFSpec Dst$, DDrv$, D%, DDir$, S%, DFile$, F%
DDrv$ = LEFT$(DDrv$, D%)
DDir$ = LEFT$(DDir$, S%)
DFile$ = LEFT$(DFile$, F%)
DPath$ = DDrv$ + ":" + DDir$
IF RIGHT$(DPath$, 1) <> "\" THEN DPath$ = DPath$ + "\"
IF INSTR(SFile$, "*") OR INSTR(SFile$, "?") THEN
IF INSTR(DFile$, "*") = 0 AND INSTR(DFile$, "?") = 0 THEN
ErrCode% = -1
EXIT SUB
END IF
END IF
Buffer$ = SPACE$(64)
FindFirstFx Buffer$, Src$, 0, ErrCode%
DO UNTIL ErrCode%
tmp$ = GetNameFx$(Buffer$)
FromFile$ = SPath$ + tmp$
ToFile$ = DPath$ + ForceMatch$(DFile$, tmp$)
IF FromFile$ = ToFile$ THEN ErrCode% = -2
IF ErrCode% = 0 THEN CopyFile FromFile$, ToFile$, ErrCode%
IF ErrCode% = 0 THEN
FileCount% = FileCount% + 1
ByteCount& = ByteCount& + GetSizeFx&(Buffer$)
FindNextFx Buffer$, ErrCode%
END IF
LOOP
IF ErrCode% = &H12 THEN ErrCode% = 0
END SUB